home *** CD-ROM | disk | FTP | other *** search
/ Mac Expert 1995 Winter / Mac Expert - Winter 95.iso / Les fichiers / Utilitaires divers / Images / Image 1.37 ƒ / Macros / Demo Macro < prev    next >
Encoding:
Text File  |  1991-03-13  |  6.1 KB  |  335 lines  |  [TEXT/MSWD]
  1. procedure AdvanceRoi;
  2. begin
  3.   hloc:=hloc+RoiWidth;
  4.   if (hloc+RoiWidth div 2)>PicWidth then begin
  5.     hloc:=0;
  6.     vloc:=vloc+RoiHeight;
  7.   end;
  8.   if (hloc+RoiWidth)>PicWidth then hloc:=PicWidth-RoiWidth;
  9.   if (vloc+RoiHeight)>PicHeight then vloc:=PicHeight-RoiHeight;
  10.   MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
  11. end;
  12.  
  13.  
  14. procedure MakeBlocks(n:integer);
  15. var
  16.   i,hloc,vloc,PicWidth,PicHeight:integer;
  17.   RoiWidth,RoiHeight:integer;
  18.   scale:real;
  19. begin
  20.   GetPicSize(PicWidth,PicHeight);
  21.   scale:=1/n;
  22.   SelectAll;
  23.   SetScaling('Nearest Neighbor; Same Window');
  24.   ScaleAndRotate(scale,scale,0);
  25.   RestoreRoi;
  26.   GetRoi(hloc,vloc,RoiWidth,RoiHeight);
  27.   copy;
  28.   SelectAll;
  29.   Clear;
  30.   hloc:=0;
  31.   vloc:=0;
  32.   MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
  33.   for i:=1 to n*n do begin
  34.     Paste;
  35.     AdvanceRoi;
  36.   end;
  37.   KillRoi;
  38. end;
  39.  
  40.  
  41. procedure DoTextDemo;
  42. begin
  43.   RevertToSaved;
  44.   MoveTo(100,20);
  45.   SetForegroundColor(255);
  46.   SetBackgroundColor(0);
  47.   SetFont('Geneva');
  48.   SetFontSize(24);
  49.   SetText('No background, Bold, Center');
  50.   Writeln('Text');
  51.   SetText('With background');
  52.   Writeln('With Background');
  53.   SetText('Bold');
  54.   Writeln('Bold');
  55.   SetText('Underlined');
  56.   Writeln('Underlined');
  57.   SetText('Italic');
  58.   Writeln('Italics');
  59.   SetText('Outline');
  60.   Writeln('Outlined');
  61.   SetText('Shadow');
  62.   Writeln('Shadowed');
  63.   SetText('Plain');
  64.   SetFontSize(9);
  65.   MoveTo(100,240);
  66.   Writeln('Very small');
  67.   wait(.5);
  68.   SetFontSize(24);
  69.   MoveTo(100,240);
  70.   Writeln('Small')
  71.   wait(.5);
  72.   SetFontSize(48);
  73.   MoveTo(100,240);
  74.   SetText('Bold');
  75.   Writeln('MEDIAN')
  76.   wait(.5);
  77.   SetFontSize(96);
  78.   MoveTo(100,240);
  79.   Writeln('LARGE')
  80.   wait(1);
  81. end;
  82.  
  83.  
  84. procedure DrawGrayLevelScale(nBoxes:integer);
  85. var
  86.   PicWidth, PicHeight,i,GrayLevel,hloc,vloc,width,height,vdelta:integer;
  87. begin
  88.   GetPicSize(PicWidth,PicHeight);
  89.   SetFont('Helvetica');
  90.   SetFontSize(9);
  91.   SetText('Bold; Center; with background');
  92.   SetBackgroundColor(0);
  93.   width:=0.9*PicHeight/nBoxes;
  94.   height:=width;
  95.   hloc:=0.05*PicHeight
  96.   vloc:=hloc;
  97.   vdelta:=height-1;
  98.   GrayLevel:=0;
  99.   for i:=1 to nBoxes do begin
  100.     MakeRoi(hloc,vloc,width,height);
  101.     SetForeground(GrayLevel);
  102.     Fill;
  103.     SetForeground(255);
  104.     DrawBoundary;
  105.     MoveTo(hloc+width/2,vloc+height/2);
  106.     Writeln(GrayLevel);
  107.     GrayLevel:=GrayLevel+trunc(256/nBoxes);
  108.     vloc:=vloc+vdelta;
  109.   end;
  110. end;
  111.  
  112.  
  113. procedure DrawColorScale;
  114. var
  115.   top,left,width,height,nLabels,i,tvloc:integer;
  116. begin
  117.   nLabels:=16;
  118.   SetFontSize(12);
  119.   SetFont('Helvetica');
  120.   SetText('Right Justified');
  121.   DrawScale;
  122.   GetRoi(left,top,width,height);
  123.   KillRoi;
  124.   SetForeground(255); {black}
  125.   SetBackground(0); {255}
  126.   vloc:=top;for i:=1 to nLabels do begin
  127.     MoveTo(left+width+25,vloc+3);
  128.     tvloc:=vloc;
  129.     if tvloc>(top+height-1) then tvloc:=Top+height-1;
  130.     Writeln(GetPixel(left,tvloc));
  131.     vloc:=vloc+round(height/(nLabels-1));
  132.   end; 
  133. end;
  134.  
  135.  
  136. procedure DoColorScaleDemo;
  137. var
  138.   PicWidth,PicHeight,hloc,vloc,ScaleWidth,ScaleHeight:integer;
  139. begin
  140.   GetPicSize(PicWidth,PicHeight);
  141.   width:=0.1*PicWidth;
  142.   if width>40 then width:=40;
  143.   height:=0.9*PicHeight;
  144.   hloc:=0.05*PicHeight
  145.   vloc:=hloc;
  146.   SetPalette('Spectrum');
  147.   MakeRoi(hloc,vloc,width,height);
  148.   DrawColorScale;
  149.   wait(2);
  150.   SetPalette('Grayscale');
  151. end;
  152.  
  153.  
  154. procedure DemoFilters;
  155. var
  156.   hloc,vloc,RoiWidth,RoiHeight,PicWidth,PicHeight:integer;
  157. begin
  158.   MakeBlocks(3);
  159.   RestoreRoi;
  160.   GetRoi(hloc,vloc,RoiWidth,RoiHeight);
  161.   GetPicSize(PicWidth,PicHeight);
  162.   hloc:=0; vloc:=0;
  163.   AdvanceRoi;
  164.   SetOption; Sharpen;
  165.   AdvanceRoi;
  166.   Shadow;
  167.   AdvanceRoi;
  168.   TraceEdges;
  169.   AdvanceRoi;
  170.   SetOption; Smooth;
  171.   TraceEdges;
  172.   Skeletonize;
  173.   AdvanceRoi;
  174.   Dither;
  175.   AdvanceRoi;
  176.   Invert;
  177.   AdvanceRoi;
  178.   FlipVertical;
  179.   AdvanceRoi;
  180.   FlipHorizontal;
  181. end;
  182.  
  183.  
  184. procedure MakeGrayLevelGrid;
  185. var
  186.   i,hloc,vloc,PicWidth,PicHeight:integer;
  187.   RoiWidth,RoiHeight,GrayLevel,increment:integer;
  188.   scale:real;
  189. begin
  190.   n:=5;
  191.   GetPicSize(PicWidth,PicHeight);
  192.   hloc:=0;
  193.   vloc:=0;
  194.   RoiWidth:=PicWidth div n;
  195.   RoiHeight:=PicHeight div n;
  196.   MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
  197.   GrayLevel:=255;
  198.   increment:=round(256/(n*n));
  199.   SetLineWidth(1);
  200.   for i:=1 to n*n do begin
  201.     SetForeground(GrayLevel);
  202.     fill;
  203.     SetForeground(0);
  204.     DrawBoundary;
  205.     GrayLevel:=GrayLevel-increment;
  206.     if GrayLevel<0 then GrayLevel:=0;
  207.     AdvanceRoi;
  208.   end;
  209.   KillRoi;
  210. end;
  211.  
  212.  
  213. macro 'Demo Macro [D]'
  214. {
  215. This macro demonstrate many of the features available in Image's macro
  216. language. It assumes the Image at least as large as`256x256 has been opened.
  217. }
  218. var
  219.   i:integer;
  220.   width,height,n,W,H:integer;
  221.   scale:real;
  222.   NoImage:boolean;
  223. begin
  224.   NoImage:=nPics<>1;
  225.   if not NoImage then GetPicSize(width,height);
  226.   if NoImage or (width<256) or (height<256) then begin
  227.     PutMessage('This macro needs a single image at least 256 pixels wide and 256 pixels high  to operate on.');
  228.     Exit;
  229.   end;
  230.  
  231.   DemoFilters;
  232.   wait(2);
  233.  
  234.   RevertToSaved;
  235.   MakeGrayLevelGrid;
  236.   wait(1);
  237.  
  238.   RevertToSaved;
  239.   DrawGrayLevelScale(12);
  240.   wait(1);
  241.  
  242.   RevertToSaved;
  243.   DoColorScaleDemo;
  244.  
  245.   DoTextDemo;
  246.  
  247.  
  248.   RevertToSaved;
  249.   SetScaling('Nearest Neighbor; Same Window');
  250.   for i:= 1 to 4 do begin
  251.     ScaleAndRotate(1.5,1.5,0);
  252.     wait(.5);
  253.   end;
  254.  
  255.   RevertToSaved;
  256.   for i:=1 to 6 do begin
  257.     ScaleAndRotate(0.6,0.6,0);
  258.     wait(.5);
  259.     RestoreRoi;
  260.   end;
  261.  
  262.   RevertToSaved;
  263.   wait(.5)
  264.   ScaleAndRotate(.333,1,0);
  265.   wait(1);
  266.   Undo;
  267.   ScaleAndRotate(1,.333,0);
  268.   wait(1);
  269.  
  270.   Undo;;
  271.   FlipVertical;
  272.   wait(.5);
  273.   Undo;
  274.   FlipHorizontal;
  275.   wait(.5);
  276.   Undo;
  277.   RotateRight(true);
  278.   RotateLeft(true);
  279.  
  280.   Shadow;
  281.   Wait(1);
  282.  
  283.   Undo;
  284.   Duplicate('Temp');
  285.   Smooth;
  286.   for i:=1 to 3 do begin SetOption; Sharpen end;
  287.   wait(.5);
  288.   Dispose;
  289.   SelectPic(1);
  290.   Dither;
  291.   wait(.5);
  292.  
  293.   Undo;
  294.   AddConstant(100);
  295.   Wait(1);
  296.   Undo;
  297.   AddConstant(-100);
  298.   Wait(1);
  299.   EnhanceContrast;
  300.   Wait(.5);
  301.   Undo;
  302.   EqualizeHistogram;
  303.   Wait(.5);
  304.   ResetGraymap;
  305.   ShowHistogram;
  306.  
  307.   Smooth;
  308.   TraceEdges;
  309.   wait(.5);
  310.   Erode;
  311.   Dilate;
  312.   Outline;
  313.   Undo;
  314.   Skeletonize;
  315.   Wait(1);
  316.   for i:= 1 to 12 do TraceEdges;
  317. end;
  318.  
  319.  
  320. macro 'Make Wallpaper [M]'
  321. var
  322.   width,height,n:integer;
  323. begin
  324.   GetPicSize(width,height);
  325.   if (width=0) then begin
  326.     PutMessage('This macro needs an image to operate on.');
  327.     Exit;
  328.   end;
  329.   n:=trunc(GetNumber('Replication factor:',8));
  330.   MakeBlocks(n);
  331. end;
  332.  
  333.  
  334.  
  335.